1 Preface

Load R packages and functions

library(tidyverse)
#> Warning: package 'tidyverse' was built under R version 4.2.1
#> ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
#> ✔ ggplot2 3.3.6      ✔ purrr   0.3.4 
#> ✔ tibble  3.1.8      ✔ dplyr   1.0.10
#> ✔ tidyr   1.2.1      ✔ stringr 1.4.1 
#> ✔ readr   2.1.2      ✔ forcats 0.5.2
#> Warning: package 'ggplot2' was built under R version 4.2.1
#> Warning: package 'tibble' was built under R version 4.2.1
#> Warning: package 'tidyr' was built under R version 4.2.1
#> Warning: package 'readr' was built under R version 4.2.1
#> Warning: package 'dplyr' was built under R version 4.2.1
#> Warning: package 'stringr' was built under R version 4.2.1
#> Warning: package 'forcats' was built under R version 4.2.1
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag()    masks stats::lag()
# install.packages("plyr")
library(plyr)
#> Warning: package 'plyr' was built under R version 4.2.1
#> ------------------------------------------------------------------------------
#> You have loaded plyr after dplyr - this is likely to cause problems.
#> If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
#> library(plyr); library(dplyr)
#> ------------------------------------------------------------------------------
#> 
#> Attaching package: 'plyr'
#> 
#> The following objects are masked from 'package:dplyr':
#> 
#>     arrange, count, desc, failwith, id, mutate, rename, summarise,
#>     summarize
#> 
#> The following object is masked from 'package:purrr':
#> 
#>     compact
# devtools::install_github("pavlakrotka/NCC@v1.0")
library(NCC)
#> Registered S3 methods overwritten by 'registry':
#>   method               from 
#>   print.registry_field proxy
#>   print.registry_entry proxy
#> Warning: package 'memoise' was built under R version 4.2.1
source("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/aux_functions.R")

2 Case Study

We illustrate the optimal allocations in platform trials by means of a phase II placebo-controlled trial in primary hypercholesterolemia.

In the original study, patients were randomised to the three arms following 1:1:1. In what follows, we used this trial as a motivating study to describe how the patients would have been allocated to the different arms and periods using three allocation strategies -namely, equal allocation (1:…:1), square root of \(k\) (1:…:\(\sqrt(k)\)) and the proposed optimal allocations-, and according to three different trial designs:

  1. Design with one period only (that is, multi-arm design)
  2. Design with two periods (arm 2 starts later, but arms 1 and 2 finish at the same time)
  3. Design with three periods (arm 2 starts later and finishes after arm 1 does)

We also compare the power and type 1 error by means of simulations where we considered the estimated mean in the control arm in the original study. For comparative purposes, in this case study, we suppose total sample size of \(N=80\) and smaller effect sizes. Also, we considered a trial using concurrent controls only.

# means
mean_control = 17.3/3.5
mean_arm1 = 66.2/3.5
mean_arm2 = 72.3/3.5

2.1 Design 1: multi-arm design

In this case, we consider a design with one period only. The scheme of the trial over time is:

db1_one = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db1_sqrt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db1_opt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db1_one$data$treatment) 
Figure: Design 1: multi-arm design.

Figure: Design 1: multi-arm design.

# sample sizes
db1_one$ss
#>      [,1] [,2] [,3]
#> [1,]   27    0    0
#> [2,]   27    0    0
#> [3,]   27    0    0
db1_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]   23    0    0
#> [2,]   23    0    0
#> [3,]   33    0    0
db1_opt$ss
#>      [,1] [,2] [,3]
#> [1,]   23    0    0
#> [2,]   23    0    0
#> [3,]   33    0    0

db1_one_ss <- data.frame(arms=c("A1","A2","C"),db1_one$ss, c(sum(db1_one$ss[1,]),sum(db1_one$ss[2,]),sum(db1_one$ss[3,])))
db1_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db1_sqrt$ss, c(sum(db1_sqrt$ss[1,]),sum(db1_sqrt$ss[2,]),sum(db1_sqrt$ss[3,])))
db1_opt_ss <- data.frame(arms=c("A1","A2","C"), db1_opt$ss, c(sum(db1_opt$ss[1,]),sum(db1_opt$ss[2,]),sum(db1_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db1_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 27 0 0 27
A2 27 0 0 27
C 27 0 0 27
knitr::kable(db1_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 23 0 0 23
A2 23 0 0 23
C 33 0 0 33
knitr::kable(db1_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 23 0 0 23
A2 23 0 0 23
C 33 0 0 33

Comparing groups when using 1:1 allocation

res1_one = do.call(rbind.data.frame, models_cc(data = db1_one$data) )
knitr::kable(res1_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 16.01093 13.41777 18.60408 TRUE a1
0 15.55270 12.85205 18.25335 TRUE a2

Comparing groups when using \(\sqrt(k)\)-allocation (and thus optimal allocations)

res1_opt = do.call(rbind.data.frame, models_cc(data = db1_opt$data) )
knitr::kable(res1_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.25836 10.46643 16.05029 TRUE a1
0 16.49544 13.96783 19.02306 TRUE a2

2.2 Design 2: two-period design

N = 80
N1 = round(N/4)
N2 = round(N-N1)
c(N1,N2,N-N1-N2)
#> [1] 20 60  0

In this case, we consider a design with two periods. The scheme of the trial over time is:

db2_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db2_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db2_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db2_one$data$treatment) 
Figure: Design 2: two-period design.

Figure: Design 2: two-period design.

# sample sizes
db2_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   20    0
#> [2,]   10   20    0
#> [3,]   10   20    0
db2_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   18    0
#> [2,]   10   18    0
#> [3,]   10   25    0
db2_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   24    0
#> [2,]   10   10    0
#> [3,]   10   26    0

db2_one_ss <- data.frame(arms=c("A1","A2","C"),db2_one$ss, c(sum(db2_one$ss[1,]),sum(db2_one$ss[2,]),sum(db2_one$ss[3,])))
db2_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db2_sqrt$ss, c(sum(db2_sqrt$ss[1,]),sum(db2_sqrt$ss[2,]),sum(db2_sqrt$ss[3,])))
db2_opt_ss <- data.frame(arms=c("A1","A2","C"), db2_opt$ss, c(sum(db2_opt$ss[1,]),sum(db2_opt$ss[2,]),sum(db2_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db2_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 20 0 20
A2 10 20 0 30
C 10 20 0 30
knitr::kable(db2_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 18 0 18
A2 10 18 0 28
C 10 25 0 35
knitr::kable(db2_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 24 0 24
A2 10 10 0 20
C 10 26 0 36

Comparing groups when using 1:1 allocation

res2_one = do.call(rbind.data.frame, models_cc(data = db2_one$data) )
knitr::kable(res2_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.08101 11.49865 14.66336 TRUE a1
0 15.87080 13.54438 18.19723 TRUE a2

Comparing groups when using \(\sqrt(k)\)-allocation

res2_sqrt = do.call(rbind.data.frame, models_cc(data = db2_sqrt$data) )
knitr::kable(res2_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.26413 11.66374 14.86453 TRUE a1
0 14.34197 11.94262 16.74132 TRUE a2

Comparing groups when using the optimal allocations

res2_opt = do.call(rbind.data.frame, models_cc(data = db2_opt$data) )
knitr::kable(res2_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.55084 11.84782 15.25386 TRUE a1
0 16.23535 14.29386 18.17685 TRUE a2

2.3 Design 3: three-period design

Suppose now a design with three periods with \(N_1=31\) and consider two situations for \(N_2\), say \(N_2=N-N_1\) and \(N_2= N_1/2\).

2.3.1 Trial with equal allocation rates for periods 1 and 3

Suppose now that the size of the periods are:

N1 = round(N/3)
N2 = round(N-2*N1)
c(N, N1, N2, N-N1-N2)
#> [1] 80 27 26 27

Note that in this case the duration of periods 1 and 3 is the same, leading to a symmetrical trial. Below we illustrate the scheme of the trial over time.


db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")

plot_trial(db3_opt$data$treatment) 
Design 3: three-period design (r1=r3).

Design 3: three-period design (r1=r3).


# sample sizes
db3_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0    9   13
#> [2,]   14    9    0
#> [3,]   14    9   13
db3_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0    8   13
#> [2,]   14    8    0
#> [3,]   14   11   13
db3_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0    8   13
#> [2,]   14    8    0
#> [3,]   14   11   13

db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 9 13 22
A2 14 9 0 23
C 14 9 13 36
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 8 13 21
A2 14 8 0 22
C 14 11 13 38
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 8 13 21
A2 14 8 0 22
C 14 11 13 38

Comparing groups when using 1:1 allocation

res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
knitr::kable(res3_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.77077 12.68510 14.85644 TRUE a1
0 14.55572 13.49474 15.61669 TRUE a2

Comparing groups when using \(\sqrt(k)\)-allocation

res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
knitr::kable(res3_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.59788 12.53378 14.66199 TRUE a1
0 15.81046 14.62007 17.00085 TRUE a2

Comparing groups when using the optimal allocations

res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
knitr::kable(res3_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.03789 11.80427 14.27152 TRUE a1
0 15.64012 14.52241 16.75782 TRUE a2

2.3.2 Trial with unequal allocation rates for for periods 1 and 3

Suppose now that the size of the periods are:

# N = 80
N1 = round(N/3)
N2 = round(2*(N-N1)/3)
c(N1,N2,N-N1-N2) 
#> [1] 27 35 18
db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")

plot_trial(db3_opt$data$treatment) 
Design 3: three-period design (r1<r3).

Design 3: three-period design (r1<r3).


# sample sizes
db3_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   12    9
#> [2,]   14   12    0
#> [3,]   14   12    9
db3_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   10    9
#> [2,]   14   10    0
#> [3,]   14   14    9
db3_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   13    9
#> [2,]   14    7    0
#> [3,]   14   15    9

db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 12 9 21
A2 14 12 0 26
C 14 12 9 35
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 10 9 19
A2 14 10 0 24
C 14 14 9 37
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 13 9 22
A2 14 7 0 21
C 14 15 9 38

Comparing groups when using 1:1 allocation

res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
knitr::kable(res3_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 15.38102 14.28894 16.47311 TRUE a1
0 16.88597 15.52827 18.24367 TRUE a2

Comparing groups when using \(\sqrt(k)\)-allocation

res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
knitr::kable(res3_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.82508 12.70810 14.94206 TRUE a1
0 15.18625 13.96799 16.40451 TRUE a2

Comparing groups when using the optimal allocations

res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
knitr::kable(res3_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm
0 13.42321 12.20348 14.64294 TRUE a1
0 16.78099 15.58322 17.97876 TRUE a2

3 Simulations

load("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/results/simstudy_results.RData")
df_res$design = ifelse(as.numeric(df_res$r1)+as.numeric(df_res$r2)==1,"2-period", "3-period")

To compare power and type 1 error of the different designs, we undertake a simulation study to evaluate the performance when using 1:1 allocations. For comparative purposes, we also consider a total sample size for the trial equal to XX

res_report_H1 <- df_res %>% filter(H0=="FALSE") %>% select(minrt,rt_a1,rt_a2,r1,r2,alloc,design)
knitr::kable(res_report_H1, format = "markdown", caption = c("Power comparisons"), col.names=c("Min Power", "Power A1", "Power A2", "r1",   "r2",   "Allocation",   "Design"))
Power comparisons
Min Power Power A1 Power A2 r1 r2 Allocation Design
0.90015 0.93188 0.90015 0.3375 0.4375 one 3-period
0.91773 0.91773 0.92704 0.3375 0.4375 opt 3-period
0.91739 0.94009 0.91739 0.3375 0.4375 sqrt 3-period
0.40323 0.71062 0.40323 0.25 0.75 one 2-period
0.48907 0.6354 0.48907 0.25 0.75 opt 2-period
0.40952 0.70559 0.40952 0.25 0.75 sqrt 2-period
res_report_H0 <- df_res %>% filter(H0=="TRUE") %>% select(minrt,rt_a1,rt_a2,r1,r2,alloc,design)
knitr::kable(res_report_H0, format = "markdown", caption = c("Type 1 error rate"), col.names=c("Min T1E", "T1E A1", "T1E A2",   "r1",   "r2",   "Allocation",   "Design"))
Type 1 error rate
Min T1E T1E A1 T1E A2 r1 r2 Allocation Design
0.0252 0.0252 0.02542 0.3375 0.4375 one 3-period
0.0245 0.02456 0.0245 0.3375 0.4375 opt 3-period
0.02396 0.02483 0.02396 0.3375 0.4375 sqrt 3-period
0.02464 0.02464 0.02515 0.25 0.75 one 2-period
0.02139 0.02139 0.02433 0.25 0.75 opt 2-period
0.02425 0.02425 0.02471 0.25 0.75 sqrt 2-period
 

Center for Medical Statistics, Informatics and Intelligent Systems, Medical University of Vienna.

[Klassifizierung: vertraulich]

Marta Bofill Roig

marta.bofillroig@meduniwien.ac.at

and Martin Posch

martin.posch@meduniwien.ac.at